package DataAccess;
use strict;
use warnings;
use Storable ( );
use Exporter;

# user modules
use SimpleError;
use FieldHash;

use constant { DA_OVERWRITE => 1, };
use constant { DA_SQL_INSERT => 0, DA_SQL_REPLACE => 1, DA_SQL_VALUES => 0, DA_SQL_SET => 2, };
use constant SQL_PRIMARY_KEYS => qw(Waf_No ICWaf_No Xadr Yadr);

# exports
our @ISA = qw(Exporter);
our @EXPORT      = qw( );
our @EXPORT_OK   = qw( DA_OVERWRITE DA_SQL_INSERT DA_SQL_REPLACE DA_SQL_VALUES DA_SQL_SET );
our %EXPORT_TAGS = (
    constants => [ qw( DA_OVERWRITE DA_SQL_INSERT DA_SQL_REPLACE DA_SQL_VALUES DA_SQL_SET ) ],
);
#our @EXPORT_OK   = @{ $EXPORT_TAGS{'constants'} };


sub new {
    my $class = shift;
    my $self = +{ @_ };
    bless $self, $class;
}

sub store {
    my $self = shift;
    my ($data, $filename, $mode) = @_;
    $filename = defined $filename ? $filename :
        defined $self->{File_Name} ? $self->{File_Name} : error("no file name");
    $data     = defined $data ? $data :
        defined $self->{Data} ? $self->{Data} : error("no data");
    $mode     = defined $mode ? $mode :
        defined $self->{Mode} ? $self->{Mode} : 0;
    return undef unless $self->check_file($filename);
    message("storing '$data' to file '$filename'.");
    Storable::nstore($data, $filename);
    $self->{File_Name} = $filename;
    $self->{Data} = $data;
    $self->{Mode} = $mode;
    return 1;
}

sub retrieve {
    my $self = shift;
    my ($filename) = @_;
    return $self->{Data} if defined $self->{Data};
    $filename = defined $filename ? $filename :
        defined $self->{File_Name} ? $self->{File_Name} : error("no file name given to retrieve");
    error("$filename: cannot retrieve: file not found.") unless (-f $filename);
    $self->{Data} = Storable::retrieve($filename) or error("cannot retrieve from $filename: $!");
    $self->{File_Name} = $filename;
    return $self->{Data};
}

sub set {
    my $self = shift;
    %{ $self } = ( %$self, @_ );
    return $self;
}

sub get_data {
    my $self = shift;
    return $self->{Data};
}

sub set_data {
    my $self = shift;
    error("no data given") unless @_ == 1;
    $self->{Data} = $_[0];
}

sub set_file {
    my $self = shift;
    $self->{File_Name} = $_[0];
}

sub get_ic {
    my $self = shift;
    my ($ic_id) = @_;
    my $ic_no;
    if (ref $ic_id eq 'ARRAY') {
        my ($x, $y) = @$ic_id;
        $ic_no = $self->{Data}{Adr_Table}{$x}{$y}[0];
    } else {
        $ic_no = $ic_id;
    }
    tie my $ic_acc, 'FieldHash', $self->{Data}{Dies_Data}[0], $self->{Data}{Dies_Data}[$ic_no];
}

### returns count of dies reduced
sub reduce_retest {
    my $self = shift;
    my ($style) = @_;
    my $overwrite_count = 0;
    my $parse_dies = $self->{Data}{Parse_Dies};
    my $gross_dies = $self->{Data}{Gross_Dies};
    my $dies_data  = $self->{Data}{Dies_Data};
    message("counts of dies: parsed=$self->{Data}{Parse_Dies}, gross=$self->{Data}{Gross_Dies}, present=$#$dies_data");
    if ($#$dies_data == $gross_dies) {
        message("no need to reduce!");
        return 0;
    }
    if ($style == 1) { # leave the first time CP data
        message("leave only FIRST CP data");
        $overwrite_count = $parse_dies - $gross_dies;
    } elsif ($style == 2) {
        my $adr_tbl = $self->{Data}{Adr_Table};
        message("leave only LAST CP data");
        for my $x (keys %$adr_tbl) {
            for my $y (keys %{$adr_tbl->{$x}}) {
                my $ic_nos = $adr_tbl->{$x}{$y};
                next unless @$ic_nos > 1; # unless there is retest
                $overwrite_count++;
                my $first_no = $ic_nos->[ 0 ];
                my $last_no = $ic_nos->[ $#$ic_nos ];
                $dies_data->[$first_no] = $dies_data->[$last_no]; # overwrite the first CP data
                message("overwrite IC data [$first_no] with [$last_no]");
            }
        }
    }
    if ($overwrite_count > 0) {
        message("overwrote $overwrite_count dies' data");
    } else {
        message("no retest data found");
    }
    $#{ $self->{Data}{Dies_Data} } = $self->{Data}{Gross_Dies}; # shrink!
    return $overwrite_count;
}

sub dump_data_list {
    my $self = shift;
    my ($file) = @_;
    my $i = 0;
    my $len = 0;
    return undef unless $self->check_file($file);
    open DUMP_LIST, '>', $file or error("cannot open output: '$file': $!");
    my $field_names = $self->{'Data'}{'Dies_Data'}[0];
    for (@$field_names) { $len = length($_) if length($_) > $len; }
    $len += 8 - $len % 8;
    message("dumping data names to '$file'...");
    print DUMP_LIST join("\n",
        map(sprintf("%-${len}s # %d", $_, $i++), @$field_names)
        ), "\n";
    close DUMP_LIST or warning("error when closing '$file': $!");
    1;
}

sub dump_log_struct {
    my $self = shift;
    my ($file) = @_;
    $self->table_print($self->{'Data'}{'Log_Struct'}, $file)
        or warning("problem when dumping");
    1;
}

sub dump_addr_table {
    my $self = shift;
    my ($file) = @_;
    message("dumping dies CP addresses to '$file'");
    my @tbl;
    push @tbl, [ qw( Xadr Yadr ), 'IC#' ];
    for my $x ( keys %{$self->{Data}{Adr_Table}} ) {
        my $x_row = $self->{Data}{Adr_Table}{$x};
        for my $y ( keys %$x_row) {
            my $ic_nos = $x_row->{$y};
            ##{{SAFE_MODE}}
            error("IC numbers exist!") if defined $tbl[ $ic_nos->[0] ];
            $tbl[ $ic_nos->[0] ] = [ $x, $y, join('/', @$ic_nos) ];
            #SimpleError::debug("IC#: $ic_nos->[0] $x $y @$ic_nos");
        }
    }
    $self->table_print(\@tbl, $file) or warning("problem when dumping");
    1;
}

sub dump_dies {
    my $self = shift;
    my ($file, $list) = @_;
    return undef unless $self->check_file($file);
    open DIES, '>', $file or error("cannot write to '$file': $!");
    message("dumping dies' CP data to '$file'...");
    $self->table_print($self->{'Data'}{'Dies_Data'}, \*DIES, $list);
    print DIES "\n";
    # additional information
    for (keys %{$self->{Data}}) {
        next if ref $self->{Data}{$_}; # non reference members
        print DIES join($self->{'FS'}, $_, $self->{Data}{$_}), "\n";
    }
    close DIES or warning("problem when closing file: $file");
    1;
}

sub dump_sql {
    my $self = shift;
    my ($sql_file, $data_list) = @_;
    ### check file existence
    return undef unless $self->check_file($sql_file);
    ### time reckoning
    my $begin_time = time();
    message("dumping BEGIN: ", scalar localtime($begin_time));
    ### variables
    $self->{Data}{Test_Program_Name} =~ /(hm\D?\d{1,4})/i;
    my $device_name = uc($1);
    my $sql_table = defined $self->{'SQL_Table'} ? $self->{'SQL_Table'} :
        ( ($device_name ? "${device_name}_" : '') . $self->{'Data'}{'Lot_Number'} );
    $sql_table =~ s/\W+/_/g;
    my $sql_mode = defined $self->{'SQL_Mode'} ? $self->{'SQL_Mode'} : 0;
    my $insert_string = $sql_mode & DA_SQL_REPLACE ? "REPLACE INTO `%s`" : "INSERT INTO `%s`";
    my $sql_types = $self->{'Data'}{'SQL_Types'};
    my $dies_data = $self->{'Data'}{'Dies_Data'};
    my @out_fields = defined $data_list ? read_name_list($data_list) : @{ $dies_data->[0] };
    #SimpleError::debug("using sql mode: $sql_mode");
    #SimpleError::debug("data list: $data_list");
    tie my %fields, 'FieldHash', $dies_data->[0];
    tie my %types,  'FieldHash', $dies_data->[0], $sql_types;
    ### open output
    open SQL_OUT, '>', $sql_file or error("cannot write to '$sql_file': $!");
    ### comments
    print SQL_OUT <<"EOCOMMENT";
-- This is an automatically generated file, EDIT WITH CAUTION.
-- * To use another table name, go to the end of the file, where
--   there is a commented 'RENAME TABLE' statement, use your favorite
--   new table name there.
-- Wafer Information:
EOCOMMENT
    for (qw(Lot_Number Wafer_Number Log_File Test_Program_Name Gross_Dies Parse_Dies CP_Start CP_End)) {
        printf SQL_OUT ("--   %-20s: %s\n", $_, $self->{Data}{$_});
    }
    ### table creation
    my $name_len = 0;
    for (@out_fields) { $name_len = length($_)+2 if length($_)+2 > $name_len; }
    $name_len += 4 - $name_len % 4;
    printf SQL_OUT ("CREATE TABLE IF NOT EXISTS `%s` (\n", $sql_table);
    for (@out_fields) {
        printf SQL_OUT ("  %-${name_len}s %s,\n", "`$_`", $types{$_});
    }
    print SQL_OUT ("  PRIMARY KEY (",
        join(", ", map( "`$_`", SQL_PRIMARY_KEYS) ), ")\n);\n");
    ### data rows
    unless ($sql_mode & DA_SQL_SET) {
        printf SQL_OUT ("%s INTO `%s`\n", $sql_mode & DA_SQL_REPLACE ? 'REPLACE' : 'INSERT', $sql_table);
        print SQL_OUT "(", join( ", ", map("`$_`", @out_fields) ), ")\nVALUES\n";
    }
    for my $i (1 .. $#$dies_data) {
        my $row = $dies_data->[$i];
        (tied %fields)->data($row);
        ### if / else the same code, maintain one and modify the other accordingly
        if ($sql_mode & DA_SQL_SET) {
            print SQL_OUT "INSERT INTO `$sql_table` SET ", join( ", ",
                map {;
                    sprintf("`%s`=%s", $_, $types{$_} =~ /^DOUBLE$|INT$|^INTEGER$/ ? $fields{$_} : "'$fields{$_}'")
                } (@out_fields)
            ), ";\n";
        } else {
            print SQL_OUT "(", join( ", ",
                map {;
                    $fields{$_} eq '' ? 'NULL' :
                    $types{$_} =~ /^DOUBLE$|INT$|^INTEGER$/ ? $fields{$_} : "'$fields{$_}'"
                } (@out_fields)
            ), ")", $i == $#$dies_data ? ";\n" : ",\n";
        }
    }
    ### optional table renaming
    printf SQL_OUT "-- RENAME TABLE `%s` TO `New_Table`;\n", $sql_table;
    ### time reckoning
    my $end_time = time();
    message("dumping   END: ", scalar localtime($end_time));
    message("Time consumed: ", $end_time - $begin_time, " second(s)");
    1;
}

sub get_collection {
    my $self = shift;
    my ($item, $condition) = @_;
    my $dies_data = $self->{Data}{Dies_Data};
    my @coll;
    tie my %fields, 'FieldHash', $dies_data->[0];
    for my $i (1 .. $#{ $dies_data }) {
        # skip those not satisfied under given condition
        next if (defined($condition) && !$condition->(\%fields));
        my $ic_data = $dies_data->[$i];
        (tied %fields)->data($ic_data);
        push @coll, ref($item) eq 'CODE' ?
            $item->(\%fields) : $fields{$item};
    }
    return \@coll;
}

sub get_collection_ext {
    my $self = shift;
    my ($items, $condition) = @_;
    my $dies_data = $self->{Data}{Dies_Data};
    my @coll;
    error("only accepts item specification as array ref") unless ref($items) eq 'ARRAY';
    tie my %fields, 'FieldHash', $dies_data->[0];
    for my $i (1 .. $#{ $dies_data }) {
        my $ic_data = $dies_data->[$i];
        my @one_die;
        (tied %fields)->data($ic_data);
        if (defined($condition) && ! $condition->(\%fields)) {
            next;
        } else {
            for my $item (@$items) {
                push @one_die, ref $item eq 'CODE' ?
                    $item->(\%fields, $self->{Data}{Adr_Table}) : $fields{$item};
            }
        }
        push @coll, \@one_die;
    }
    return \@coll;
}

sub check_file {
    my $self = shift;
    my ($file) = @_;
    ## 0: file exists, can't overwrite
    ## 1: file not exists, so it's okay
    ## 2: file exists, but try to overwrite
    if (-f $file) {
        warning("file '$file' exists");
        if ($self->{Mode} & DA_OVERWRITE) {
            warning("overwriting '$file'...");
            return 2;
        } else {
            warning("writting to '$file' skipped...");
            return 0;
        }
    }
    1;
}

sub mode {
    my $self = shift;
    $self->{Mode} = $_[0] if @_;
    return $self->{Mode};
}

sub table_print {
    my $self = shift;
    my ($table, $file, $list) = @_;
    my $fh;
    my $fs = defined $self->{'FS'} ? $self->{'FS'} : ',';
    unless (ref $file) { # if $file is scalar (file name), then open it
        return undef unless $self->check_file($file);
        open $fh, '>', "$file" or error("cannot open output file: $file");
    } else { # otherwise it's a file handle
        $fh = $file;
    }
    message("$table (@{[scalar @$table]} row(s))");
    if (defined $list) {
        my @selected_field_names = read_name_list($list);
        tie my %field, 'FieldHash', $table->[0];
        for my $row (@$table) { # heading line is also included
            (tied %field)->data($row);
            print $fh (
                join( $fs, map( {; $field{$_}; } @selected_field_names ) ), "\n"
            );
        }
    } else {
        print $fh map(join($fs, @$_) . "\n", @$table);
    }
    unless (ref $file) {
        close $fh or warning("problem when closing file: $file");
    }
    1;
}

### class method
sub read_name_list {
    my ($file) = @_;
    my @names;
    open READ_LIST, '<', $file or error("cannot open list: '$file': $!");
    while (<READ_LIST>) {
        chomp; s/(?:^| )[\#\;].*$//; # comment
        next if /^\s*$/;
        push @names, split(/\s+/, $_);
    }
    close READ_LIST or warning("problem when closing list file: '$file'");
    return @names;
}

1;
